10 REM VT52 EMULATOR
20 REM (C) COPYRIGHT RICHARD GILLMANN 1982
21 REM MAY BE COPIED AND USED FREELY BY ANYONE FOR NON-COMMERCIAL PURPOSES
22 REM REQUIRES 96K
23 REM IBM ASYNC. PKG "RS232INT.BAS" MUST BE ON DEFAULT DISKETTE
24 REM RUNS UNDER "BASIC" ONLY, WILL NOT WORK WITH "BASICA"
30 PASS=1
40 DEFINT A-Z:KEY OFF:SCREEN 0,0,0:LOCATE ,,1
50 PRINT "VT52 Emulator"
60 PRINT "(C) Copyright Richard Gillmann 1982"
70 PRINT
72 INPUT "Baud rate = ",BAUD
74 PRINT
80 FOR I=1 TO 10:KEY I,"":NEXT
90 TRUE=-1:FALSE=0
100 ON ERROR GOTO 2260
110 REM LOAD MACHINE LANGUAGE COMM PROGRAM (96K SYSTEM REQUIRED)
120 DEF SEG=&H1700
130 BLOAD "RS232INT",0
140 SETSENSE=&H0
150 BREAK=&H10
160 BUFSIZE=&H20
170 RECEIVE=&H30
180 SEND=&H40
190 REM INITIALIZE COMM
200 CHAN%=1
210 TYPE%=7
220 DAT%=0
230 ERFLG%=-1
240 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
250 IF ERFLG%<>-1 THEN STOP
260 REM SET BAUD RATE
270 TYPE%=3
280 DAT%=BAUD
290 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
300 IF ERFLG%<>-1 THEN STOP
310 REM SET PARITY
320 TYPE%=5
330 DAT%=3 'mark
340 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
350 IF ERFLG%<>-1 THEN STOP
360 REM SET STOP BITS
370 TYPE%=6
380 DAT%=1
390 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
400 IF ERFLG%<>-1 THEN STOP
410 REM SET RECEIVE DATA MODIFIERS
420 TYPE%=9
430 FOR I = &H0 TO &H1F
440 DAT%=256 + I
450 IF I=&H7 OR I=&H8 OR I=&H9 OR I=&HA OR I=&HD OR I=&H1B THEN DAT%=DAT%+256
460 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
470 IF ERFLG%<>-1 THEN STOP
480 NEXT I
490 DAT%=256 + &H7F
500 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
510 IF ERFLG%<>-1 THEN STOP
520 REM ACTIVATE COMM
530 TYPE%=7
540 DAT%=1
550 CALL SETSENSE(CHAN%,TYPE%,DAT%,ERFLG%)
560 IF ERFLG%<>-1 THEN STOP
570 REM MAIN COMM LOOP
580 ST$=STRING$(255," ")
590 BEL$=CHR$(&H7)
600 BS$=CHR$(&H8)
605 TAB$=CHR$(&H9)
610 LF$=CHR$(&HA)
620 CR$=CHR$(&HD)
630 ESC$=CHR$(&H1B)
640 STATE=0
650 IF PASS=2 THEN SYSTEM
660 PRINT "F1 = Upload ASCII file to PRIMOS"
670 PRINT "F2 = Download ASCII file from PRIMOS"
672 PRINT "F3 = Upload ASCII file to TOPS-20"
674 PRINT "F4 = Download ASCII file from TOPS-20"
680 PRINT "F7 = A: file directory"
690 PRINT "F8 = B: file directory"
700 PRINT "F9 = Terminate communication"
710 PRINT "F10 = BREAK key"
720 PRINT
730 PRINT "Ready to communicate"
735 LOCATE ,,1
740 REM PRINT INCOMING CHARACTERS
750 CALL RECEIVE(CHAN%,LN%,ST$,ERFLG%)
760 IF LN%<=0 GOTO 870
770 STO$=LEFT$(ST$,LN%)
780 LAST$=RIGHT$(STO$,1)
790 IF STATE>0 GOTO 1190
800 IF LAST$=BEL$ GOTO 920
810 IF LAST$=BS$ GOTO 970
815 IF LAST$=TAB$ GOTO 1001
820 IF LAST$=LF$ GOTO 1020
830 IF LAST$=CR$ GOTO 1080
840 IF LAST$=ESC$ GOTO 1130
850 PRINT STO$;
860 REM SEND OUTGOING CHARACTER
870 STI$=INKEY$
880 ON LEN(STI$)+1 GOTO 750,890,1660
890 CALL SEND(CHAN%,STI$,ERFLG%)
900 GOTO 750
910 REM BELL
920 STO$=LEFT$(STO$,LN%-1)
930 PRINT STO$;
940 BEEP
950 GOTO 870
960 REM BACKSPACE
970 STO$=LEFT$(STO$,LN%-1)
980 PRINT STO$;
990 IF POS(0)>1 THEN LOCATE ,POS(0)-1,1
1000 GOTO 870
1001 REM TAB
1002 STO$=LEFT$(STO$,LN%-1)
1003 PRINT STO$;
1004 LOCATE ,INT((POS(0)-1)/8)*8+9,1
1005 GOTO 870
1019 REM LINEFEED
1020 STO$=LEFT$(STO$,LN%-1)
1030 PRINT STO$;
1040 OLDPOS=POS(0)
1050 IF CSRLIN>=24 THEN PRINT:LOCATE 24,OLDPOS,1 ELSE LOCATE CSRLIN+1,,1
1060 GOTO 870
1070 REM CARRIAGE RETURN
1080 STO$=LEFT$(STO$,LN%-1)
1090 PRINT STO$;
1100 LOCATE ,1,1
1110 GOTO 870
1120 REM ESCAPE
1130 STO$=LEFT$(STO$,LN%-1)
1140 PRINT STO$;
1150 ST$=STRING$(1," ")
1160 STATE=1
1170 GOTO 870
1180 REM PROCESS ESCAPE SEQUENCE
1190 ON STATE GOTO 1210,1570,1620
1200 REM JUST AFTER ESCAPE
1210 IF STO$="H" GOTO 1310
1220 IF STO$="J" GOTO 1340
1230 IF STO$="K" GOTO 1450
1240 IF STO$="Y" GOTO 1500
1250 IF STO$="Z" GOTO 1530
1260 IF STO$=ESC$ GOTO 870
1270 ST$=STRING$(255," ")
1280 STATE=0
1290 GOTO 870
1300 REM $H = HOME CURSOR
1310 LOCATE 1,1,1
1320 GOTO 1270
1330 REM $J = CLEAR TO END OF SCREEN
1340 IF CSRLIN=1 AND POS(0)=1 THEN CLS:GOTO 1270
1350 OLDLIN=CSRLIN:OLDPOS=POS(0)
1360 GOSUB 2670 'erase EOL
1370 IF CSRLIN>=24 GOTO 1410
1380 FOR I=CSRLIN+1 TO 24
1390 LOCATE I,1,1:GOSUB 2670 ' erase EOL
1400 NEXT I
1410 LOCATE OLDLIN,OLDPOS,1
1420 GOTO 1270
1430 REM $K = CLEAR TO END OF LINE
1440 IF POS(0)>=80 GOTO 1270
1450 OLDLIN=CSRLIN:OLDPOS=POS(0)
1460 GOSUB 2670 ' erase EOL
1470 LOCATE OLDLIN,OLDPOS,1
1480 GOTO 1270
1490 REM $Y = POSITION CURSOR
1500 STATE=2
1510 GOTO 870
1520 REM $Z = REPLY $/K
1530 STO$=ESC$+"/K"
1540 CALL SEND(CHAN%,STO$,ERFLG%)
1550 GOTO 1270
1560 REM CURSOR POSITIONING -- LINE NUMBER
1570 LINE1=ASC(STO$)-ASC(" ")+1
1580 LOCATE LINE1,,1
1590 STATE=3
1600 GOTO 870
1610 REM CURSOR ADDRESSING -- COLUMN NUMBER
1620 COLUMN=ASC(STO$)-ASC(" ")+1
1630 LOCATE ,COLUMN,1
1640 GOTO 1270
1650 REM FUNCTION KEYS
1660 LAST1=ASC(RIGHT$(STI$,1))
1670 IF LAST1=59 THEN TARGET$="PRIMOS":GOTO 1850
1680 IF LAST1=60 THEN TARGET$="PRIMOS":GOTO 2300
1682 IF LAST1=61 THEN TARGET$="TOPS-20":GOTO 1850
1684 IF LAST1=62 THEN TARGET$="TOPS-20":GOTO 2300
1690 IF LAST1=65 THEN FILES "A:*.*":GOTO 750
1700 IF LAST1=66 THEN FILES "B:*.*":GOTO 750
1710 IF LAST1=67 THEN PASS=2:GOTO 120
1720 IF LAST1=68 THEN CALL BREAK(CHAN%,ERFLG%):GOTO 750
1730 GOTO 750
1740 REM RECEIVE INCOMING CHARACTERS AND PRINT COUNT LINES OF THEM
1750 IF COUNT<=0 THEN RETURN
1760 CALL RECEIVE(CHAN%,LN%,ST$,ERFLG%)
1770 IF LN%<=0 GOTO 1760
1780 STO$=LEFT$(ST$,LN%)
1790 LAST$=RIGHT$(STO$,1)
1800 IF LAST$=CR$ THEN PRINT LEFT$(STO$,LN%-1):COUNT=COUNT-1:GOTO 1750
1810 IF LAST$=LF$ THEN PRINT LEFT$(STO$,LN%-1);:GOTO 1760
1820 PRINT STO$;
1830 GOTO 1760
1840 REM UPLOAD ASCII FILE
1850 OLDLIN=CSRLIN:OLDPOS=POS(0)
1860 LOCATE 25,1,1:GOSUB 2670 ' erase EOL
1870 IF TARGET$="PRIMOS" THEN INPUT; "Upload ASCII file to PRIMOS (Y/N)"; YN$
1875 IF TARGET$="TOPS-20" THEN INPUT; "Upload ASCII file to TOPS-20 (Y/N)"; YN$
1880 IF LEFT$(YN$,1)="N" OR LEFT$(YN$,1)="n" GOTO 750
1890 LOCATE 25,1,1:GOSUB 2670 'erase EOL
1900 INPUT; "Personal Computer source file"; SOURCE$
1910 ON ERROR GOTO 1960
1920 OPEN SOURCE$ FOR INPUT AS #1
1930 GOTO 2010
1940 PRINT "Error - upload ends"
1950 GOTO 750
1960 LOCATE 25,1,1:GOSUB 2670 'erase EOL
1970 PRINT "Unable to open source file - upload ends";
1980 LOCATE OLDLIN,OLDPOS,1
1990 ON ERROR GOTO 2260
2000 GOTO 750
2010 ON ERROR GOTO 1940
2020 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2030 IF TARGET$="PRIMOS" THEN INPUT; "PRIMOS destination file"; DESTIN$
2035 IF TARGET$="TOPS-20" THEN INPUT; "TOPS-20 destination file"; DESTIN$
2040 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2050 LOCATE OLDLIN,OLDPOS,1
2060 IF TARGET$="PRIMOS" THEN STO$="SEG #PCFTP"
2062 IF TARGET$="TOPS-20" THEN STO$="PCFTP"
2065 STO$=STO$+CR$+DESTIN$+CR$+"UP"+CR$
2070 CALL SEND(CHAN%,STO$,ERFLG%)
2080 IF ERFLG%<>-1 GOTO 750
2090 ON ERROR GOTO 2180
2100 COUNT=3:GOSUB 1750 'receive and print
2110 IF EOF(1) GOTO 2180
2120 LINE INPUT#1, STO$
2130 STO$=STO$+CR$
2140 CALL SEND(CHAN%,STO$,ERFLG%)
2150 IF ERFLG%<>-1 GOTO 750
2160 COUNT=1:GOSUB 1750 'receive and print
2170 GOTO 2110
2180 STO$="!E!"+CR$
2190 CALL SEND(CHAN%,STO$,ERFLG%)
2200 IF ERFLG%<>-1 GOTO 750
2210 COUNT=1:GOSUB 1750 'receive and print
2220 CLOSE#1
2230 ON ERROR GOTO 2260
2240 GOTO 750
2250 REM DEFAULT ERROR HANDLER
2260 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2270 PRINT "Error - ignored"
2280 RESUME
2290 REM DOWNLOAD ASCII FILE
2300 OLDLIN=CSRLIN:OLDPOS=POS(0)
2310 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2320 IF TARGET$="PRIMOS" THEN INPUT; "Download ASCII file from PRIMOS"; YN$
2325 IF TARGET$="TOPS-20" THEN INPUT; "Download ASCII file from TOPS-20"; YN$
2330 IF LEFT$(YN$,1)="N" OR LEFT$(YN$,1)="n" GOTO 750
2340 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2350 IF TARGET$="PRIMOS" THEN INPUT; "PRIMOS source file"; SOURCE$
2355 IF TARGET$="TOPS-20" THEN INPUT; "TOPS-20 source file"; SOURCE$
2360 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2370 INPUT; "Personal Computer destination file"; DESTIN$
2380 ON ERROR GOTO 2410
2390 OPEN DESTIN$ FOR OUTPUT AS #1
2400 GOTO 2450
2410 LOCATE 25,1,1:GOSUB 2670 'erase EOL
2420 PRINT "Unable to open destination file - download ends";
2430 ON ERROR GOTO 2260
2440 GOTO 750
2450 ON ERROR GOTO 2260
2460 LOCATE 25,1,1:GOSUB 2670:LOCATE OLDLIN,OLDPOS,1
2470 IF TARGET$="PRIMOS" THEN STO$="SEG #PCFTP"
2472 IF TARGET$="TOPS-20" THEN STO$="TER NO PAGE"+CR$+"PCFTP"
2475 STO$=STO$+CR$+SOURCE$+CR$+"DOWN"+CR$
2480 CALL SEND(CHAN%,STO$,ERFLG%)
2490 IF TARGET$="PRIMOS" THEN COUNT=3:GOSUB 1750 ELSE COUNT=4:GOSUB 1750
2500 ON ERROR GOTO 2260
2510 FOO$="":OLDFOO$="":FLAG=FALSE
2520 CALL RECEIVE(CHAN%,LN%,ST$,ERFLG%)
2530 IF LN%=0 GOTO 2520
2540 STO$=LEFT$(ST$,LN%)
2550 LAST$=RIGHT$(STO$,1)
2560 IF LAST$=LF$ THEN FOO$=FOO$+LEFT$(STO$,LN%-1):GOTO 2520
2570 IF LAST$<>CR$ THEN FOO$=FOO$+STO$:GOTO 2520
2580 FOO$=FOO$+LEFT$(STO$,LN%-1)
2590 IF FLAG THEN PRINT#1, OLDFOO$
2600 PRINT FOO$
2610 OLDFOO$=FOO$:FOO$="":FLAG=TRUE
2620 IF OLDFOO$<>"!E!" GOTO 2520
2630 CLOSE#1
2640 ON ERROR GOTO 2260
2650 GOTO 750
2660 REM ERASE TO END OF LINE
2670 OP=POS(0)
2680 IF OP>79 THEN RETURN
2690 PRINT SPC(80-OP)
2700 LOCATE ,OP,1
2710 RETURN
2760 REM ERASE TO END OF LINE
2670 OP=POS(0)
2680 IF OP>79 THEN RETURN
2690 PRINT SPC(80-OP)
2700 LOCATE ,OP,1
2710 RETURN